home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / emacs / cmuscheme48.el < prev    next >
Lisp/Scheme  |  1995-10-13  |  4KB  |  100 lines
  1. ;;; cmuscheme48.el -- Scheme process in a buffer.  Adapted from cmuscheme.el.
  2.  
  3. (provide 'cmuscheme48)
  4. (require 'cmuscheme)
  5.  
  6. (define-key scheme-mode-map "\M-\C-x" 'scheme48-send-definition);gnu convention
  7. (define-key scheme-mode-map "\C-x\C-e" 'scheme48-send-last-sexp);gnu convention
  8. (define-key scheme-mode-map "\C-ce"    'scheme48-send-definition)
  9. (define-key scheme-mode-map "\C-c\C-e" 'scheme48-send-definition-and-go)
  10. (define-key scheme-mode-map "\C-cr"    'scheme48-send-region)
  11. (define-key scheme-mode-map "\C-c\C-r" 'scheme48-send-region-and-go)
  12. (define-key scheme-mode-map "\C-cl"    'scheme48-load-file)
  13.  
  14. (defun scheme48-send-region (start end)
  15.   "Send the current region to the inferior Scheme process."
  16.   (interactive "r")
  17.   (comint-send-string (scheme-proc)
  18.               (concat ",from-file "
  19.                   (enough-scheme-file-name
  20.                    (buffer-file-name (current-buffer)))
  21.                   "\n"))
  22.   (comint-send-region (scheme-proc) start end)
  23.   (comint-send-string (scheme-proc) " ,end\n"))
  24.  
  25. ; This assumes that when you load things into Scheme 48, you type
  26. ; names of files in your home directory using the syntax "~/".
  27. ; Similarly for current directory.  Maybe we ought to send multiple
  28. ; file names to Scheme and let it look at all of them.
  29.  
  30. (defun enough-scheme-file-name (file)
  31.   (let* ((scheme-dir
  32.       (save-excursion
  33.         (set-buffer scheme-buffer)
  34.         (expand-file-name default-directory)))
  35.      (len (length scheme-dir)))
  36.     (if (and (> (length file) len)
  37.          (string-equal scheme-dir (substring file 0 len)))
  38.     (substring file len)
  39.     (if *scheme48-home-directory-kludge*
  40.         (let* ((home-dir (expand-file-name "~/"))
  41.            (len (length home-dir)))
  42.           (if (and (> (length file) len)
  43.                (string-equal home-dir (substring file 0 len)))
  44.           (concat "~/" (substring file len))
  45.           file))
  46.         file))))
  47.  
  48. (defvar *scheme48-home-directory-kludge* t)
  49.  
  50. (defun scheme48-send-definition (losep)
  51.   "Send the current definition to the inferior Scheme48 process."
  52.   (interactive "P")
  53.   (save-excursion
  54.    (end-of-defun)
  55.    (let ((end (point)))
  56.      (beginning-of-defun)
  57.      (if losep
  58.      (let ((loser "/tmp/s48lose.tmp"))
  59.        (write-region (point) end loser)
  60.        (scheme48-load-file loser))
  61.      (scheme48-send-region (point) end)))))
  62.  
  63. (defun scheme48-send-last-sexp ()
  64.   "Send the previous sexp to the inferior Scheme process."
  65.   (interactive)
  66.   (scheme48-send-region (save-excursion (backward-sexp) (point)) (point)))
  67.  
  68. (defun scheme48-send-region-and-go (start end)
  69.   "Send the current region to the inferior Scheme48 process,
  70. and switch to the process buffer."
  71.   (interactive "r")
  72.   (scheme48-send-region start end)
  73.   (switch-to-scheme t))
  74.  
  75. (defun scheme48-send-definition-and-go (losep)
  76.   "Send the current definition to the inferior Scheme48,
  77. and switch to the process buffer."
  78.   (interactive "P")
  79.   (scheme48-send-definition losep)
  80.   (switch-to-scheme t))
  81.  
  82. (defun scheme48-load-file (file-name)
  83.   "Load a Scheme file into the inferior Scheme48 process."
  84.   (interactive (comint-get-source "Load Scheme48 file: "
  85.                   scheme-prev-l/c-dir/file
  86.                   scheme-source-modes t)) ; T because LOAD 
  87.                                                           ; needs an exact name
  88.   (comint-check-source file-name) ; Check to see if buffer needs saved.
  89.   (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
  90.                        (file-name-nondirectory file-name)))
  91.   (comint-send-string (scheme-proc)
  92.               (concat ",load "
  93.                   (enough-scheme-file-name file-name)
  94.                   "\n")))
  95.  
  96.  
  97. ; For Pertti Kellom\"aki's debugger.
  98. ; Cf. misc/psd-s48.scm.
  99. (defvar psd-using-slib nil "Scheme 48, not SLIB.")
  100.